Landing Page - Crime Map

Column

Crimes, plotted using leaflet. This map can be zoomed in on interactively and the station names will be displayed upon clicking the icon.


https://rstudio.github.io/leaflet/

  • Interactive panning/zooming

  • Notice the icons, when clicked, display the crime description and time when it was committed/reported

Column

Data

Case Number Date Primary Type Description
HY189866 03/18/2015 07:44:00 PM BATTERY AGGRAVATED: HANDGUN
HY190059 03/18/2015 11:00:00 PM OTHER OFFENSE PAROLE VIOLATION
HY190052 03/18/2015 10:45:00 PM BATTERY DOMESTIC BATTERY SIMPLE
HY190054 03/18/2015 10:30:00 PM BATTERY SIMPLE
HY189976 03/18/2015 09:00:00 PM ROBBERY ARMED: HANDGUN
HY190032 03/18/2015 10:00:00 PM BATTERY SIMPLE
HY190047 03/18/2015 11:00:00 PM BATTERY DOMESTIC BATTERY SIMPLE
HY189988 03/18/2015 09:35:00 PM BATTERY DOMESTIC BATTERY SIMPLE
HY190020 03/18/2015 10:09:00 PM NARCOTICS POSS: CANNABIS 30GMS OR LESS
HY189964 03/18/2015 09:25:00 PM BATTERY SIMPLE
HY189984 03/18/2015 09:30:00 PM CRIMINAL DAMAGE TO VEHICLE
HY189719 03/15/2015 04:10:00 PM OTHER OFFENSE HARASSMENT BY TELEPHONE
HY189966 03/18/2015 09:14:00 PM WEAPONS VIOLATION UNLAWFUL POSS OF HANDGUN
HY190056 03/18/2015 10:50:00 PM BATTERY SIMPLE
HY190019 03/18/2015 10:31:00 PM THEFT RETAIL THEFT
HY189725 03/18/2015 12:55:00 PM BURGLARY FORCIBLE ENTRY
HY190071 03/18/2015 08:00:00 PM MOTOR VEHICLE THEFT AUTOMOBILE
HY190036 03/18/2015 09:00:00 PM THEFT FROM BUILDING
HY190063 03/18/2015 10:56:00 PM PUBLIC PEACE VIOLATION RECKLESS CONDUCT
HY190068 03/18/2015 10:45:00 PM THEFT FROM BUILDING

Crimes Involving Use of Firearm

Case Number Date Primary Type Description
HY134412 01/30/2015 04:57:39 PM WEAPONS VIOLATION UNLAWFUL POSS OF HANDGUN
HY190274 03/18/2015 01:00:00 PM ROBBERY ARMED: HANDGUN
HY189866 03/18/2015 07:44:00 PM BATTERY AGGRAVATED: HANDGUN
HY189976 03/18/2015 09:00:00 PM ROBBERY ARMED: HANDGUN
HY189966 03/18/2015 09:14:00 PM WEAPONS VIOLATION UNLAWFUL POSS OF HANDGUN
HY189969 03/18/2015 09:44:00 PM WEAPONS VIOLATION UNLAWFUL USE HANDGUN
HY190003 03/18/2015 09:59:00 PM BATTERY AGGRAVATED: HANDGUN
HY190043 03/18/2015 11:00:00 PM BATTERY AGGRAVATED: HANDGUN
HY190067 03/18/2015 11:20:00 PM BATTERY AGGRAVATED: HANDGUN
HY191604 03/18/2015 12:50:00 PM ASSAULT AGGRAVATED: HANDGUN
HY190586 03/19/2015 01:10:00 PM WEAPONS VIOLATION UNLAWFUL POSS OF HANDGUN
HY190103 03/19/2015 01:50:00 AM ROBBERY ARMED: HANDGUN
HY190658 03/19/2015 02:26:00 PM WEAPONS VIOLATION UNLAWFUL POSS OF HANDGUN
HY190920 03/19/2015 04:09:00 PM OTHER OFFENSE GUN OFFENDER: ANNUAL REGISTRATION
HY190959 03/19/2015 05:43:00 PM ASSAULT AGGRAVATED: HANDGUN
HY190962 03/19/2015 05:52:00 PM WEAPONS VIOLATION UNLAWFUL POSS OF HANDGUN
HY191027 03/19/2015 06:40:00 PM WEAPONS VIOLATION UNLAWFUL POSS OF HANDGUN
HY191010 03/19/2015 06:45:00 PM ROBBERY ARMED: HANDGUN
HY191030 03/19/2015 07:01:00 PM WEAPONS VIOLATION UNLAWFUL POSS OF HANDGUN
HY191116 03/19/2015 07:37:00 PM WEAPONS VIOLATION UNLAWFUL POSS OF HANDGUN

Arrests Made

Case Number Date Arrest Primary Type Description
HY123079 01/20/2015 06:10:00 PM TRUE NARCOTICS FORFEIT PROPERTY
HY133401 01/29/2015 06:16:44 PM TRUE NARCOTICS POSS: CRACK
HY134412 01/30/2015 04:57:39 PM TRUE WEAPONS VIOLATION UNLAWFUL POSS OF HANDGUN
HY133975 01/30/2015 11:50:18 AM TRUE NARCOTICS POSS: CRACK
HY138419 02/03/2015 03:38:00 PM TRUE NARCOTICS MANU/DELIVER: HEROIN (WHITE)
HY138450 02/03/2015 04:00:00 PM TRUE NARCOTICS MANU/DELIVER: HEROIN (WHITE)
HY139499 02/04/2015 11:55:21 AM TRUE NARCOTICS POSS: CANNABIS 30GMS OR LESS
HY190480 02/19/2015 01:30:00 PM TRUE THEFT RETAIL THEFT
HY157138 02/19/2015 05:36:00 PM TRUE NARCOTICS MANU/DELIVER: HEROIN (WHITE)
HY172764 03/05/2015 01:40:00 PM TRUE NARCOTICS MANU/DELIVER: HEROIN (WHITE)
HY172795 03/05/2015 01:41:00 PM TRUE NARCOTICS MANU/DELIVER: HEROIN (WHITE)
HY172353 03/05/2015 06:35:00 AM TRUE NARCOTICS CRIMINAL DRUG CONSPIRACY
HY174264 03/06/2015 01:40:00 PM TRUE NARCOTICS MANU/DELIVER:CRACK
HY173967 03/06/2015 01:50:00 PM TRUE NARCOTICS MANU/DEL:CANNABIS 10GM OR LESS
HY174332 03/06/2015 05:38:00 PM TRUE NARCOTICS MANU/DELIVER:CRACK
HY174440 03/06/2015 07:04:00 PM TRUE NARCOTICS POSS: HEROIN(WHITE)
HY174329 03/06/2015 12:38:00 PM TRUE NARCOTICS POSS: CANNABIS 30GMS OR LESS
HY175365 03/07/2015 04:00:00 PM TRUE NARCOTICS MANU/DEL:CANNABIS 10GM OR LESS
HY191612 03/09/2015 09:00:00 AM TRUE BATTERY SIMPLE
HY179885 03/11/2015 09:15:00 AM TRUE OTHER OFFENSE LICENSE VIOLATION

Crime Features

Clusters

Custom Gun Icons

Tile Layers

Circle Layers

Custom icon colors

Treemap

Heatmap

Ward Features

Crime Totals By Ward

Crime Totals By Ward, Layered By Primary Type

---
title: "Chicago Crime Dashboard"
author: "Zack Larsen"
date: "May 18, 2019"
output: 
  flexdashboard::flex_dashboard:
    social: [ "twitter", "facebook", "menu" ]
    navbar:
      - { title: "About Me", href: "https://zacklarsen.github.io/" }
      - { icon: "fa-github", href: "https://github.com/ZackLarsen", align: right}
      - { icon: "fa-linkedin", href: "https://www.linkedin.com/in/larsenzachary/", align: right}
    source: embed
---

```{r setup, include=FALSE}
library(pacman)
library(tidyverse)
p_load(flexdashboard, leaflet, leaflet.extras, dplyr, ggvis, here, conflicted, data.table, jsonlite, kableExtra, glue, geosphere, DT, networkD3, htmltools, geojsonio, magrittr, treemap, highcharter, viridisLite, ggmap)
conflict_prefer("filter", "dplyr")

here::here() # "/Users/zacklarsen/Zack_Master/Projects/Dataviz/R/Divvy_Flex"

stations <- fromJSON("https://feeds.divvybikes.com/stations/stations.json")

crimes <- fread(here("data","Crimes_sample.csv")) %>% 
  na.omit()

ward_boundaries <- geojsonio::geojson_read(here("data","Boundaries_Wards.geojson"), what = "sp")

```


Landing Page - Crime Map
=========================================

Column 
-------------------------------------

### Crimes, plotted using leaflet. This map can be zoomed in on interactively and the station names will be displayed upon clicking the icon.

```{r, cache=TRUE}

crimes_popup <- crimes %>% 
  mutate(
    popup_text = paste(
      sep = "
", glue("{`Primary Type`}"), Description, Date, paste(Latitude, Longitude, sep=', ') ) ) %>% na.omit() my_map <- leaflet(crimes_popup) %>% addTiles() %>% addMarkers(lat = crimes_popup$Latitude, lng = crimes_popup$Longitude, label = lapply(crimes_popup$popup_text, HTML) ) my_map ``` *** https://rstudio.github.io/leaflet/ - Interactive panning/zooming - Notice the icons, when clicked, display the crime description and time when it was committed/reported Column {.tabset} ------------------------------------- ### Data ```{r, cache=TRUE} crimes %>% select(`Case Number`, Date, `Primary Type`, Description) %>% head(n=20) %>% kable() %>% kable_styling() ``` ### Crimes Involving Use of Firearm ```{r, cache=TRUE, eval=TRUE} crimes %>% filter(grepl("GUN",Description)) %>% select(`Case Number`, Date, `Primary Type`, Description) %>% arrange(Date) %>% head(n=20) %>% kable() %>% kable_styling() ``` ### Arrests Made ```{r, cache=TRUE, eval=TRUE} crimes %>% filter(Arrest == TRUE) %>% select(`Case Number`, Date, Arrest, `Primary Type`, Description) %>% arrange(Date) %>% head(n=20) %>% kable() %>% kable_styling() ``` Crime Features {.storyboard} ========================================= ### Clusters ```{r, cache=TRUE, eval=TRUE} crimes_full <- crimes %>% na.omit() leaflet(crimes_full) %>% addTiles() %>% addMarkers( lat = crimes_full$Latitude, lng = crimes_full$Longitude, clusterOptions = markerClusterOptions() ) ``` ### Custom Gun Icons ```{r, cache=TRUE, eval=TRUE} # https://rstudio.github.io/leaflet/markers.html gunIcon <- makeIcon( iconUrl = here("handgun.png"), iconWidth = 35, iconHeight = 35, iconAnchorX = 0, iconAnchorY = 10 ) leaflet(crimes %>% filter(grepl("GUN",Description)) %>% na.omit()) %>% addTiles() %>% addMarkers(~Longitude, ~Latitude, icon = gunIcon) ``` ### Tile Layers ```{r, cache=TRUE, eval=TRUE} leaflet(crimes) %>% # Base groups addTiles(group = "Default") %>% addProviderTiles(providers$Stamen.Toner, group = "Toner") %>% addProviderTiles(providers$NASAGIBS.ViirsEarthAtNight2012, group = "NASA") %>% addProviderTiles(providers$Stamen.Watercolor, group = "Watercolor") %>% # Overlay groups addCircles(~Longitude, ~Latitude, group = "Crimes") %>% # Layers control addLayersControl( baseGroups = c("Default", "Toner", "NASA", "Watercolor"), overlayGroups = c("Crimes"), options = layersControlOptions(collapsed = FALSE) ) ``` ### Circle Layers ```{r, cache=TRUE, eval=TRUE} BATTERY <- crimes[crimes$`Primary Type` == 'BATTERY',] ROBBERY <- crimes[crimes$`Primary Type` == 'ROBBERY',] HOMICIDE <- crimes[crimes$`Primary Type` == 'HOMICIDE',] ASSAULT <- crimes[crimes$`Primary Type` == 'ASSAULT',] PROSTITUTION <- crimes[crimes$`Primary Type` == 'PROSTITUTION',] GTA <- crimes[crimes$`Primary Type` == 'MOTOR VEHICLE THEFT',] leaflet(crimes) %>% # Base groups addTiles(group = "Default") %>% # Overlay groups addCircles(~BATTERY$Longitude, ~BATTERY$Latitude, group = "BATTERY") %>% addCircles(~ROBBERY$Longitude, ~ROBBERY$Latitude, group = "ROBBERY") %>% addCircles(~HOMICIDE$Longitude, ~HOMICIDE$Latitude, group = "HOMICIDE") %>% addCircles(~ASSAULT$Longitude, ~ASSAULT$Latitude, group = "ASSAULT") %>% addCircles(~PROSTITUTION$Longitude, ~PROSTITUTION$Latitude, group = "PROSTITUTION") %>% addCircles(~GTA$Longitude, ~GTA$Latitude, group = "GTA") %>% # Layers control addLayersControl( overlayGroups = c("BATTERY","ROBBERY","HOMICIDE","ASSAULT","PROSTITUTION","GTA"), options = layersControlOptions(collapsed = FALSE) ) ``` ### Custom icon colors ```{r, eval=FALSE} icons <- awesomeIcons( icon = 'ios-close', iconColor = 'black', library = 'ion', markerColor = getColor(crimes) ) leaflet(crimes) %>% addTiles() %>% addAwesomeMarkers(~Longitude, ~Latitude, icon=icons, label=~as.character(`Primary Type`)) ``` ### Treemap ```{r, cache=TRUE, eval=TRUE} thm <- hc_theme( colors = c("#1a6ecc", "#434348", "#90ed7d"), chart = list( backgroundColor = "transparent", style = list(fontFamily = "Source Sans Pro") ), xAxis = list( gridLineWidth = 1 ) ) treemap_data <- crimes %>% select(`Case Number`, `Primary Type`, Description) %>% group_by(`Primary Type`, Description) %>% summarise(Count = n_distinct(`Case Number`)) tm <- treemap(treemap_data, index = c("Primary Type", "Description"), vSize = "Count", vColor = "Count", type = "value", palette = rev(viridis(6))) highchart() %>% hc_add_series_treemap(tm, allowDrillToNode = TRUE, layoutAlgorithm = "squarified") %>% hc_add_theme(thm) ``` ### Heatmap ```{r, cache=TRUE, eval=TRUE} leaflet(crimes) %>% addTiles() %>% addHeatmap(lng=~Longitude, lat=~Latitude, radius = 8) ``` Ward Features {.storyboard} ========================================= ### Crime Totals By Ward ```{r, cache=TRUE, eval=TRUE} ward_totals <- crimes %>% select(Ward, `Primary Type`) %>% group_by(Ward) %>% summarise(n()) %<>% mutate(count = `n()`) ward_totals <- setNames(ward_totals$count, as.character(ward_totals$Ward)) ward_boundaries$crime_total <- ward_totals labels <- sprintf( "Ward #%s
%g crimes committed in this ward", ward_boundaries$ward, ward_boundaries$crime_total ) %>% lapply(htmltools::HTML) qpal <- colorQuantile("Reds", ward_boundaries$crime_total, n = 10) leaflet(ward_boundaries) %>% addTiles() %>% addPolygons(fillColor = ~qpal(crime_total), weight = 2, opacity = 1, color = "white", dashArray = "3", fillOpacity = 0.9, highlight = highlightOptions( weight = 3, # This is the width of the dashed line color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE), label = ~labels, labelOptions = labelOptions( style = list("font-weight" = "normal", padding = "3px 8px"), textsize = "15px", direction = "auto")) %>% addLegend(pal = qpal, values = ~crime_total, opacity = 0.7, title = "Crime Count Quantile", position = "topright") ``` ### Crime Totals By Ward, Layered By Primary Type ```{r, cache=TRUE, eval=FALSE} ward_totals_by_type <- crimes %>% select(Ward, `Primary Type`) %>% group_by(Ward, `Primary Type`) %>% summarise(n()) %<>% rename(count = `n()`) %>% dplyr::spread(key = `Primary Type`,value = count) ward_totals_by_type[is.na(ward_totals_by_type)] <- 0 battery_totals <- setNames(ward_totals_by_type$BATTERY, as.character(ward_totals_by_type$Ward)) robbery_totals <- setNames(ward_totals_by_type$ROBBERY, as.character(ward_totals_by_type$Ward)) homicide_totals <- setNames(ward_totals_by_type$HOMICIDE, as.character(ward_totals_by_type$Ward)) assault_totals <- setNames(ward_totals_by_type$ASSAULT, as.character(ward_totals_by_type$Ward)) prostitution_totals <- setNames(ward_totals_by_type$PROSTITUTION, as.character(ward_totals_by_type$Ward)) gta_totals <- setNames(ward_totals_by_type$`MOTOR VEHICLE THEFT`, as.character(ward_totals_by_type$Ward)) ward_boundaries$battery_total <- battery_totals ward_boundaries$robbery_total <- robbery_totals ward_boundaries$homicide_total <- homicide_totals ward_boundaries$assault_total <- assault_totals ward_boundaries$prostitution_total <- prostitution_totals ward_boundaries$gta_total <- gta_totals get_palette <- function(category){ colorQuantile("Reds", ward_boundaries$category, n = 10) } leaflet(ward_boundaries) %>% addTiles() %>% addPolygons(fillColor = ~get_palette(battery_total), weight = 2, opacity = 1, color = "white", dashArray = "3", fillOpacity = 0.9, group = "BATTERY", highlight = highlightOptions( weight = 5, color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE)) %>% addPolygons(fillColor = ~get_palette(crime_total), weight = 2, opacity = 1, color = "white", dashArray = "3", fillOpacity = 0.9, group = "ROBBERY", highlight = highlightOptions( weight = 5, color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE)) %>% addPolygons(fillColor = ~get_palette(crime_total), weight = 2, opacity = 1, color = "white", dashArray = "3", fillOpacity = 0.9, group = "HOMICIDE", highlight = highlightOptions( weight = 5, color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE)) %>% addPolygons(fillColor = ~get_palette(crime_total), weight = 2, opacity = 1, color = "white", dashArray = "3", fillOpacity = 0.9, group = "ASSAULT", highlight = highlightOptions( weight = 5, color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE)) %>% addPolygons(fillColor = ~get_palette(crime_total), weight = 2, opacity = 1, color = "white", dashArray = "3", fillOpacity = 0.9, group = "PROSTITUTION", highlight = highlightOptions( weight = 5, color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE)) %>% addPolygons(fillColor = ~get_palette(crime_total), weight = 2, opacity = 1, color = "white", dashArray = "3", fillOpacity = 0.9, group = "GTA", highlight = highlightOptions( weight = 5, color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE)) %>% addLayersControl( overlayGroups = c("BATTERY","ROBBERY","HOMICIDE","ASSAULT","PROSTITUTION","GTA"), options = layersControlOptions(collapsed = FALSE) ) ```